module IPFS.Multiaddr.IP.IPv6(
    IPv6(..),
    ipv6,
    fromWord16s,
    fromTupleWord16s,
    fromWord32s,
    fromTupleWord32s,
    toWord16s,
    toWord32s,
    localhost,
    decode,
    encode,
    parse
) where

import Prelude

import Data.Array (some)
import Data.BigInt as BI
import Data.ByteString as BS
import Data.Integral (fromIntegral)
import Data.List (List(..), (:))
import Data.Maybe (Maybe(..))
import Data.Serialize.Get (Get, getWord32be)
import Data.Shift (shl, shr)
import Data.String.CodeUnits (fromCharArray)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested (Tuple4, Tuple8, tuple4, tuple8, (/\))
import Data.UInt as U
import Data.Word (Word16, Word32, Word64, word16toBytes, (.|.))
import Text.Parsing.Parser (Parser, fail)
import Text.Parsing.Parser.Combinators (sepBy)
import Text.Parsing.Parser.String (char)
import Text.Parsing.Parser.Token (hexDigit)

newtype IPv6 = IPv6 { iPv6A :: Word64,iPv6B:: Word64}

derive instance eqIPv6 :: Eq IPv6
derive instance ordIPv6 :: Ord IPv6

instance showIPv6 :: Show IPv6 where
  show val = aa <> ":" <>  bb <> ":" <> cc <> ":" <> dd <> ":" <> ee <> ":" <> ff <> ":" <>  gg <> ":" <>  hh
    where 
     (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ unit) = toWord16s val
     to16Str =  BI.toBase 16
     aa = to16Str $ fromIntegral a
     bb = to16Str $ fromIntegral b
     cc = to16Str $ fromIntegral c
     dd = to16Str $ fromIntegral d
     ee = to16Str $ fromIntegral e
     ff = to16Str $ fromIntegral f
     gg = to16Str $ fromIntegral g
     hh = to16Str $ fromIntegral h

ipv6 ::Word16 -> Word16 -> Word16 -> Word16 
    -> Word16 -> Word16 -> Word16 -> Word16 -> IPv6
ipv6 = fromWord16s

fromWord16s ::Word16 -> Word16 -> Word16 -> Word16 
           -> Word16 -> Word16 -> Word16 -> Word16 -> IPv6
fromWord16s a b c d e f g h = IPv6 {iPv6A:w1,iPv6B:w2}
  where
    Tuple w1 w2 = fromWord16sV6 (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)
                                (fromIntegral e) (fromIntegral f) (fromIntegral g) (fromIntegral h)

fromTupleWord16s::Tuple8 Word16 Word16 Word16 Word16 Word16 Word16 Word16 Word16 -> IPv6
fromTupleWord16s (a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ unit) = fromWord16s a b c d e f g h

fromWord16sV6 :: Word64 -> Word64 -> Word64 -> Word64 
              -> Word64 -> Word64 -> Word64 -> Word64 -> Tuple Word64 Word64
fromWord16sV6 a b c d e f g h = fromWord16Word64 a b c d /\ fromWord16Word64 e f g h

fromWord16Word64 :: Word64 -> Word64 -> Word64 -> Word64 -> Word64
fromWord16Word64 a b c d = fromIntegral (shl a  (U.fromInt 48) .|.
                                         shl b  (U.fromInt 32) .|.
                                         shl c  (U.fromInt 16) .|. d)

fromWord32s::Word32 -> Word32 -> Word32 -> Word32 -> IPv6
fromWord32s a b c d = IPv6  {iPv6A:w1,iPv6B:w2}
 where 
   Tuple w1  w2 = fromWord32sV6 (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d)

fromTupleWord32s::Tuple4 Word32 Word32 Word32 Word32 -> IPv6
fromTupleWord32s (a /\ b /\ c /\ d /\ unit) = fromWord32s a b c d

fromWord32sV6 :: Word64 -> Word64 -> Word64 -> Word64 -> Tuple Word64 Word64
fromWord32sV6 a b c d = fromWord32Word64 a b /\ fromWord32Word64 c d

fromWord32Word64 :: Word64 -> Word64 -> Word64
fromWord32Word64 a b = fromIntegral (shl a (U.fromInt 32) .|. b)

toWord16s::IPv6 -> Tuple8 Word16 Word16 Word16 Word16 Word16 Word16 Word16 Word16
toWord16s (IPv6 ip) = tuple8 (fromIntegral $ shr ip.iPv6A $ U.fromInt 48)
                             (fromIntegral $ shr ip.iPv6A $ U.fromInt 32)
                             (fromIntegral $ shr ip.iPv6A $ U.fromInt 16)
                             (fromIntegral $ ip.iPv6A)
                             (fromIntegral $ shr ip.iPv6B $ U.fromInt 48)
                             (fromIntegral $ shr ip.iPv6B $ U.fromInt 32)
                             (fromIntegral $ shr ip.iPv6B $ U.fromInt 16)
                             (fromIntegral $ ip.iPv6B)

toWord32s::IPv6 -> Tuple4 Word32 Word32 Word32 Word32
toWord32s (IPv6 ip) =  tuple4 (fromIntegral $ shr ip.iPv6A $ U.fromInt 32)
                              (fromIntegral ip.iPv6A)
                              (fromIntegral $ shr ip.iPv6B $ U.fromInt 32)
                              (fromIntegral ip.iPv6B)

loopback::IPv6
loopback = IPv6 { iPv6A : (fromIntegral 0),
                  iPv6B : (fromIntegral 1) }

localhost::IPv6
localhost = loopback

encode::IPv6 -> BS.ByteString
encode  ip6 = (word16toBytes a) <> (word16toBytes b) <> (word16toBytes c) <> (word16toBytes d) <> 
              (word16toBytes e) <> (word16toBytes f) <> (word16toBytes g) <> (word16toBytes h)  
  where
   a /\ b /\ c /\ d /\ e /\ f /\ g /\ h /\ unit = toWord16s ip6


decode :: Get IPv6
decode = do
  w1 <- getWord32be
  w2 <- getWord32be
  w3 <- getWord32be
  w4 <- getWord32be
  pure $ fromWord32s w1 w2 w3 w4

parse::Parser String IPv6
parse = words >>= toIPV6
 where
   words = parseNoOXHex `sepBy` (char ':')
   toIPV6::List Word16 -> Parser String IPv6
   toIPV6 (a:b:c:d:e:f:g:h:Nil) = pure $ fromWord16s a b c d e f g h
   toIPV6          l   = fail $ "Parser IPV6 error" <> (show l)

parseNoOXHex::Parser String Word16
parseNoOXHex = do 
     chars::(Array Char) <- some hexDigit
     let mayNum = BI.fromBase 16 $ fromCharArray chars
     case mayNum of
       Nothing -> fail "Parse IPV6 error"
       Just  l -> pure $ fromIntegral l
